home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch12 / Panview1.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-16  |  11KB  |  353 lines
  1. VERSION 5.00
  2. Begin VB.Form frmPanview1 
  3.    Caption         =   "Panview1"
  4.    ClientHeight    =   3165
  5.    ClientLeft      =   2550
  6.    ClientTop       =   1800
  7.    ClientWidth     =   3150
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   3165
  11.    ScaleWidth      =   3150
  12.    Begin VB.HScrollBar HScrollBar 
  13.       Height          =   255
  14.       Left            =   0
  15.       TabIndex        =   2
  16.       Top             =   2880
  17.       Width           =   2895
  18.    End
  19.    Begin VB.VScrollBar VScrollBar 
  20.       Height          =   2895
  21.       Left            =   2880
  22.       TabIndex        =   1
  23.       Top             =   0
  24.       Width           =   255
  25.    End
  26.    Begin VB.PictureBox picViewport 
  27.       Height          =   2880
  28.       Left            =   0
  29.       ScaleHeight     =   2820
  30.       ScaleWidth      =   2820
  31.       TabIndex        =   0
  32.       Top             =   0
  33.       Width           =   2880
  34.    End
  35.    Begin VB.Menu mnuFile 
  36.       Caption         =   "&File"
  37.       Begin VB.Menu mnuFileExit 
  38.          Caption         =   "E&xit"
  39.       End
  40.    End
  41.    Begin VB.Menu mnuScale 
  42.       Caption         =   "&Scale"
  43.       Begin VB.Menu mnuScaleMag 
  44.          Caption         =   "Full  Scale"
  45.          Index           =   1
  46.          Shortcut        =   ^F
  47.       End
  48.       Begin VB.Menu mnuScaleMag 
  49.          Caption         =   "Magnify &2"
  50.          Index           =   2
  51.          Shortcut        =   {F2}
  52.       End
  53.       Begin VB.Menu mnuScaleMag 
  54.          Caption         =   "Magnify &4"
  55.          Index           =   4
  56.          Shortcut        =   {F4}
  57.       End
  58.       Begin VB.Menu mnuScaleMag 
  59.          Caption         =   "Magnify 1/2"
  60.          Index           =   20
  61.          Shortcut        =   ^{F2}
  62.       End
  63.       Begin VB.Menu mnuScaleMag 
  64.          Caption         =   "Magnify 1/4"
  65.          Index           =   40
  66.          Shortcut        =   ^{F4}
  67.       End
  68.    End
  69. Attribute VB_Name = "frmPanview1"
  70. Attribute VB_GlobalNameSpace = False
  71. Attribute VB_Creatable = False
  72. Attribute VB_PredeclaredId = True
  73. Attribute VB_Exposed = False
  74. Option Explicit
  75. ' Global max and min world coordinates
  76. ' (including margins).
  77. Private Const DataXmin = 0
  78. Private Const DataXmax = 10
  79. Private Const DataYmin = 0
  80. Private Const DataYmax = 10
  81. ' Set the min and max allowed width and height.
  82. Private Const DataMinWid = 1
  83. Private Const DataMinHgt = 1
  84. Private Const DataMaxWid = DataXmax - DataXmin
  85. Private Const DataMaxHgt = DataYmax - DataYmin
  86. ' The aspect ratio of the viewport.
  87. Private VAspect As Single
  88. ' Current world window bounds.
  89. Private Wxmin As Single
  90. Private Wxmax As Single
  91. Private Wymin As Single
  92. Private Wymax As Single
  93. ' Prevent change events when we are adjusting the
  94. ' scroll bars.
  95. Private IgnoreSbarChange As Boolean
  96. ' Adjust the world window so it is not too big,
  97. ' too small, off to one side, or of the wrong
  98. ' aspect ratio. Then map the world window to the
  99. ' viewport and force the viewport to repaint.
  100. Private Sub SetWorldWindow()
  101. Dim wid As Single
  102. Dim hgt As Single
  103. Dim xmid As Single
  104. Dim ymid As Single
  105. Dim aspect As Single
  106.     ' Find the size and center of the world window.
  107.     wid = Wxmax - Wxmin
  108.     hgt = Wymax - Wymin
  109.     xmid = (Wxmax + Wxmin) / 2
  110.     ymid = (Wymax + Wymin) / 2
  111.     ' Make sure we're not too big or too small.
  112.     If wid > DataMaxWid Then
  113.         wid = DataMaxWid
  114.     ElseIf wid < DataMinWid Then
  115.         wid = DataMinWid
  116.     End If
  117.     If hgt > DataMaxHgt Then
  118.         hgt = DataMaxHgt
  119.     ElseIf hgt < DataMinHgt Then
  120.         hgt = DataMinHgt
  121.     End If
  122.     ' Make the aspect ratio match the viewport
  123.     ' aspect ratio, VAspect (set in Form_Resize).
  124.     aspect = hgt / wid
  125.     If aspect > VAspect Then
  126.         ' Too tall and thin. Make it wider.
  127.         wid = hgt / VAspect
  128.     Else
  129.         ' Too short and wide. Make it taller.
  130.         hgt = wid * VAspect
  131.     End If
  132.     ' Compute the new coordinates
  133.     Wxmin = xmid - wid / 2
  134.     Wxmax = xmid + wid / 2
  135.     Wymin = ymid - hgt / 2
  136.     Wymax = ymid + hgt / 2
  137.     ' See if we're off to one side.
  138.     If wid > DataMaxWid Then
  139.         ' We're wider than the picture. Center.
  140.         xmid = (DataXmax + DataXmin) / 2
  141.         Wxmin = xmid - wid / 2
  142.         Wxmax = xmid + wid / 2
  143.     Else
  144.         ' Else see if we're too far to one side.
  145.         If Wxmin < DataXmin And Wxmax < DataXmax Then
  146.             ' Adjust to the right.
  147.             Wxmax = Wxmax + DataXmin - Wxmin
  148.             Wxmin = DataXmin
  149.         End If
  150.         If Wxmax > DataXmax And Wxmin > DataXmin Then
  151.             ' Adjust to the left.
  152.             Wxmin = Wxmin + DataXmax - Wxmax
  153.             Wxmax = DataXmax
  154.         End If
  155.     End If
  156.     If hgt > DataMaxHgt Then
  157.         ' We're taller than the picture. Shrink.
  158.         ymid = (DataYmax + DataYmin) / 2
  159.         Wymin = ymid - hgt / 2
  160.         Wymax = ymid + hgt / 2
  161.     Else
  162.         ' See if we're too far to top or bottom.
  163.         If Wymin < DataYmin And Wymax < DataYmax Then
  164.             ' Adjust downward.
  165.             Wymax = Wymax + DataYmin - Wymin
  166.             Wymin = DataYmin
  167.         End If
  168.         If Wymax > DataYmax And Wymin > DataYmin Then
  169.             ' Adjust upward.
  170.             Wymin = Wymin + DataYmax - Wymax
  171.             Wymax = DataYmax
  172.         End If
  173.     End If
  174.     ' Map the world window to the viewport.
  175.     picViewport.ScaleLeft = Wxmin
  176.     picViewport.ScaleTop = Wymax
  177.     picViewport.ScaleWidth = Wxmax - Wxmin
  178.     picViewport.ScaleHeight = Wymin - Wymax
  179.     ' Force the viewport to repaint.
  180.     picViewport.Refresh
  181.     ' Reset the scroll bars.
  182.     IgnoreSbarChange = True
  183.     HScrollBar.Visible = (wid < DataXmax - DataXmin)
  184.     VScrollBar.Visible = (hgt < DataYmax - DataYmin)
  185.     ' The values of the scroll bars will be where
  186.     ' the top/left of the world window should be.
  187.     VScrollBar.Min = 100 * (DataYmax)
  188.     VScrollBar.Max = 100 * (DataYmin + hgt)
  189.     HScrollBar.Min = 100 * (DataXmin)
  190.     HScrollBar.Max = 100 * (DataXmax - wid)
  191.     ' SmallChange moves the world window 1/10
  192.     ' of its width/height.
  193.     VScrollBar.SmallChange = 100 * (hgt / 10)
  194.     VScrollBar.LargeChange = 100 * hgt
  195.     HScrollBar.SmallChange = 100 * (wid / 10)
  196.     HScrollBar.LargeChange = 100 * wid
  197.     ' Set the current scroll bar values.
  198.     VScrollBar.Value = 100 * Wymax
  199.     HScrollBar.Value = 100 * Wxmin
  200.     IgnoreSbarChange = False
  201. End Sub
  202. ' Draw a smiley face in the viewport centered
  203. ' around the point (5, 5).
  204. Private Sub DrawSmiley(ByVal pic As PictureBox)
  205. Const PI = 3.14159265
  206. Dim i As Single
  207.     ' Head.
  208.     pic.FillColor = vbYellow
  209.     pic.FillStyle = vbSolid
  210.     pic.Circle (5, 5), 4
  211.     ' Nose.
  212.     pic.FillColor = RGB(0, &HFF, &H80)
  213.     pic.Circle (5, 4.5), 1, , , , 1.5
  214.     ' Eye whites.
  215.     pic.FillColor = vbWhite
  216.     pic.Circle (3.5, 6), 0.75, , , , 1.25
  217.     pic.Circle (6.5, 6), 0.75, , , , 1.25
  218.     ' Pupils.
  219.     pic.FillColor = vbBlack
  220.     pic.Circle (3.7, 6), 0.5, , , , 1.25
  221.     pic.Circle (6.7, 6), 0.5, , , , 1.25
  222.     ' Smile.
  223.     pic.Circle (5, 5), 2.75, , 1.15 * PI, 1.8 * PI
  224.     ' Draw some grid lines to make small scales
  225.     ' easier to understand.
  226.     i = DataXmin + 0.5
  227.     Do While i < DataXmax
  228.         picViewport.Line (i, DataYmin)-(i, DataYmax)
  229.         i = i + 0.5
  230.     Loop
  231.     i = DataYmin + 0.5
  232.     Do While i < DataYmax
  233.         picViewport.Line (DataXmin, i)-(DataXmax, i)
  234.         i = i + 0.5
  235.     Loop
  236. End Sub
  237. ' Change the level of magnification.
  238. Private Sub SetScaleFactor(ByVal fact As Single)
  239. Dim wid As Single
  240. Dim hgt As Single
  241. Dim mid As Single
  242.     fact = 1 / fact
  243.     ' Compute the new world window size.
  244.     wid = fact * (Wxmax - Wxmin)
  245.     hgt = fact * (Wymax - Wymin)
  246.     ' Center the new world window over the old.
  247.     mid = (Wxmax + Wxmin) / 2
  248.     Wxmin = mid - wid / 2
  249.     Wxmax = mid + wid / 2
  250.     mid = (Wymax + Wymin) / 2
  251.     Wymin = mid - hgt / 2
  252.     Wymax = mid + hgt / 2
  253.     ' Set the new world window bounds.
  254.     SetWorldWindow
  255. End Sub
  256. ' Return to the default magnification scale.
  257. Private Sub SetScaleFull()
  258.     ' Reset the world window coordinates.
  259.     Wxmin = DataXmin
  260.     Wxmax = DataXmax
  261.     Wymin = DataYmin
  262.     Wymax = DataYmax
  263.     ' Set the new world window bounds.
  264.     SetWorldWindow
  265. End Sub
  266. Private Sub Form_Resize()
  267. Dim x As Single
  268. Dim y As Single
  269. Dim wid As Single
  270. Dim hgt As Single
  271.     ' Fit the viewport to the window.
  272.     x = picViewport.Left
  273.     y = picViewport.Top
  274.     wid = ScaleWidth - 2 * x - VScrollBar.Width
  275.     hgt = ScaleHeight - 2 * y - HScrollBar.Height
  276.     picViewport.Move x, y, wid, hgt
  277.     VAspect = hgt / wid
  278.     ' Place the scroll bars next to the viewport.
  279.     x = picViewport.Left + picViewport.Width + 10
  280.     y = picViewport.Top
  281.     wid = VScrollBar.Width
  282.     hgt = picViewport.Height
  283.     VScrollBar.Move x, y, wid, hgt
  284.     x = picViewport.Left
  285.     y = picViewport.Top + picViewport.Height + 10
  286.     wid = picViewport.Width
  287.     hgt = HScrollBar.Height
  288.     HScrollBar.Move x, y, wid, hgt
  289.     ' Start at full scale.
  290.     SetScaleFull
  291. End Sub
  292. ' Move the world window.
  293. Private Sub HScrollBar_Change()
  294.     If IgnoreSbarChange Then Exit Sub
  295.     HScrollBarChanged
  296. End Sub
  297. ' The vertical scroll bar has been moved.
  298. ' Adjust the world window.
  299. Private Sub VScrollBarChanged()
  300. Dim hgt As Single
  301.     hgt = Wymax - Wymin
  302.     Wymax = VScrollBar.Value / 100
  303.     Wymin = Wymax - hgt
  304.     ' Remap the world window.
  305.     IgnoreSbarChange = True
  306.     SetWorldWindow
  307.     IgnoreSbarChange = False
  308. End Sub
  309. ' The horizontal scroll bar has been moved.
  310. ' Adjust the world window.
  311. Private Sub HScrollBarChanged()
  312. Dim wid As Single
  313.     wid = Wxmax - Wxmin
  314.     Wxmin = HScrollBar.Value / 100
  315.     Wxmax = Wxmin + wid
  316.     ' Remap the world window.
  317.     IgnoreSbarChange = True
  318.     SetWorldWindow
  319.     IgnoreSbarChange = False
  320. End Sub
  321. ' Move the world window.
  322. Private Sub HScrollBar_Scroll()
  323.     HScrollBarChanged
  324. End Sub
  325. Private Sub mnuFileExit_Click()
  326.     Unload Me
  327. End Sub
  328. ' Change the level of magnification.
  329. Private Sub mnuScaleMag_Click(Index As Integer)
  330.     If Index = 1 Then
  331.         ' Return to full scale.
  332.         SetScaleFull
  333.     ElseIf Index < 10 Then
  334.         ' Magnify by the indicated amount.
  335.         SetScaleFactor CSng(Index)
  336.     Else
  337.         ' Zoom out by 1/(Index \ 10).
  338.         SetScaleFactor 1 / (Index \ 10)
  339.     End If
  340. End Sub
  341. Private Sub picViewport_Paint()
  342.     DrawSmiley picViewport
  343. End Sub
  344. ' Move the world window.
  345. Private Sub VScrollBar_Change()
  346.     If IgnoreSbarChange Then Exit Sub
  347.     VScrollBarChanged
  348. End Sub
  349. ' Move the world window.
  350. Private Sub VScrollBar_Scroll()
  351.     VScrollBarChanged
  352. End Sub
  353.